home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / dialer.arc / DIALER.BAS next >
BASIC Source File  |  1987-08-04  |  31KB  |  1,036 lines
  1. ' DIALER.BAS - Memory resident phone dialer
  2.  
  3. ' DIALER.EXE Copyright (C) 1987 MicroHelp, Inc.
  4.  
  5. ' This program may be freely copied and distributed provided that 
  6. ' all copyright notices are left intact and that you distribute all
  7. ' of the following programs in an unmodified state:
  8.  
  9. '     DIALER.BAS, DIALER.EXE and DIALER.DOC
  10.  
  11. ' -----------------------------------------------------------------------
  12.  
  13. ' Start this program as DIALER/C if you wish to reconfigure it for 
  14. ' different defaults (file names, hot key, snow checking). See note
  15. ' below if you recompile with MS 5.36 or IBM BASCOM 1.0
  16.  
  17. ' -----------------------------------------------------------------------
  18.  
  19. ' In order to recompile this program, you need "Mach 2" (assembler 
  20. ' subroutine library) and "Stay-Res" (makes compiled BASIC programs
  21. ' memory resident), both available from MicroHelp, Inc. "Mach 2" is $69.00
  22. ' and "Stay-Res" costs $69.00.  In order to use EMS memory or "disk
  23. ' swapping" with "Stay-Res", you need the optional "EMS/Disk module", 
  24. ' which costs $50.00. (If you purchase the EMS/Disk module at the same time
  25. ' you get Stay-Res, the "combo" price is $99.00.) Note that the EMS/Disk
  26. ' module is not required -- what it does is to allow your programs
  27. ' to run in only 7K of DOS memory. Without the module, this program
  28. ' will require approximately 110-120k of memory (depending upon the
  29. ' compiler used).
  30.  
  31. ' -----------------------------------------------------------------------
  32.  
  33. ' This program was written with line numbers (instead of labels) so that
  34. ' it can be compiled with QuickBASIC 1.xx and 2.xx as well as IBM BASCOM
  35. ' 1.0 and 2.0 and Microsoft generic BASIC compiler version 5.36. With all
  36. ' of the aforementioned compilers EXCEPT QuickBASIC, you must use
  37. ' the /n switch (line numbers not required) when compiling. Due to
  38. ' a bug in DOS 2.xx, if this program is compiled with QuickBASIC 2.x, it
  39. ' requires DOS 3.0 or later to run. The DOS bug is the same one mentioned
  40. ' in the diskette documentation on the QuickBASIC 2.01 distribution
  41. ' diskette (explains why SHELL doesn't always work with DOS 2.x).
  42.  
  43. ' Note also that with MS 5.36 compiler, the hardware specific commands
  44. ' LOCATE, CLS and COLOR must be changed and you must compile with
  45. ' the /n switch (relax line numbering requirements).
  46.  
  47. ' Lastly, the program reads the command line (COMMAND$) to check for
  48. ' a /C. If you have the MS 5.36 or IBM BASCOM 1.0 compiler, the command
  49. ' line is not passed to your program. Another MicroHelp product, "The
  50. ' Inside Track" can do it for you. Otherwise you'll have to change
  51. ' the program to automatically go into configuration mode.
  52.  
  53. ' -----------------------------------------------------------------------
  54.  
  55. ' In case you're interested, the distribution copy was compiled with
  56. ' QuickBASIC 1.02, since it produces the smallest .EXE files among the
  57. ' QB family. For the absolute smallest program,
  58. ' use Microsoft's generic BASIC compiler version 5.36 on your programs.
  59. ' Just beware that it does not have the IBM hardware commands such
  60. ' as LOCATE, COLOR and CLS and it does not support communications.
  61.  
  62. ' -----------------------------------------------------------------------
  63.  
  64. ' If you would like to order "Mach 2" or "Stay-Res", or for more information
  65. ' on any MicroHelp product, call 1-800-922-3383. In Georgia, call
  66. ' 404-973-9272. MasterCard and Visa are welcome as well as Purchase Orders
  67. ' from recognized organizations (Fortune 100 or governmental bodies).
  68.  
  69. ' -----------------------------------------------------------------------
  70.  
  71. Defint A-Y            ' for faster operation and less memory usage
  72.                 ' and so we don't have to type % 
  73.                 
  74. Defstr Z            ' so we don't have to type $ all over the place
  75.  
  76. Dim Zphone.entry(200)        ' names/phone numbers, etc. 200 entries
  77. Dim Zmessage(3)            ' for instructions on bottom 3 screen lines
  78.  
  79. ' -----------------------------------------------------------------------
  80.  
  81. ' This area sets up the buffer for storing the screen image when the 
  82. ' program pops up. Stay-Res is capable of dynamically reserving memory
  83. ' (using memory outside of BASIC's data area) also, but we have enough
  84. ' room in the program to use string space - that means less memory is 
  85. ' used to run the program.
  86.  
  87.     Scr.buffer$=Space$(16404)    ' for storing screen images
  88.     Kshift=varptr(Scr.buffer$)    ' Stay-Res is used to determine
  89.     Operation=3            '  the segment address of this
  90.     gosub 50000            '  string. 50000 calls Stay-Res
  91.     
  92.     Dtaseg=Kshift            ' reserved memory segment
  93.     
  94.     Kscan=16384            ' Tells Stay-Res to save up to 16384
  95.     Operation=4            '  bytes of memory for screen
  96.     gosub 50000            '  images.
  97.  
  98.     True=-1                ' for testing variables in the program
  99.     False=0
  100.     One=1                ' for older compilers
  101.     Page=0                ' video page for Mach 2 routines
  102.     Invisible.cursor=&h1600
  103.     
  104.     For n=1 to 3
  105.       Zmessage(n)=space$(80)    ' for messages on lines 23-25
  106.     next  
  107.     
  108.     Operation=0            ' initialize the window manager
  109.     Buffer.number=1            ' number of buffers
  110.     Box=1024            ' Number of 1k blocks
  111.     gosub 50100            ' initialize the window manager
  112.         
  113. ' -----------------------------------------------------------------------
  114.  
  115. '  This area determines if a configuration file is present. If so, the
  116. '  file is loaded, otherwise the user can set up a configuration file.
  117.  
  118. '  The configuration file has 7 pieces of data:
  119.  
  120. '    Snow.checking = integer (true or false as above)
  121. '    Monitor.to.use  1=Mono, 2=Color, 3=Default
  122. '    Zdata.file = Phone directory data file name
  123. '    Scan.code = Hot key scan code
  124. '    Shift.status = Hot key shift status
  125. '    Zswap.path = Drive and path for disk swapping (DOS 3+ required)
  126. '    Port$ = COM1 or COM2
  127.  
  128. '  Each entry in the phone directory can be up to 76 columns long.
  129. '  If there is a phone number, it should begin in column 56 or higher
  130. '  and can be up to 19 characters in length.
  131.  
  132.     Snow.checking=True              ' in case no config file
  133.     Monitor.to.use=3        ' ditto (default monitor)
  134.     Zdata.file=""            ' in case no config file
  135.     Port$="COM1"            ' ditto
  136.  
  137.     gosub 51000              ' set up values for default monitor
  138.     if Monitor=&hb000 then Color 7,0,0 else Color 14,1,1
  139.     gosub 54000             ' display copyright notice
  140.  
  141.     Spec$="Dialer.cnf"+chr$(0)    ' configuration file name
  142.     gosub 54200            ' check for file presence
  143.     
  144.     If Ecode then 2000        ' no configuration file available,
  145.                     ' so go to configuration setup.
  146.  
  147.     On error goto 1500        ' if this isn't a valid file
  148.  
  149.     Open "i",1,"Dialer.cnf"        ' open the config file
  150.  
  151. 1000    
  152.  
  153.     Input #1,Snow.checking
  154.     Input #1,Monitor.to.use
  155.     Input #1,Zdata.file
  156.     Input #1,Scan.code
  157.     Input #1,Shift.status
  158.     Input #1,Zswap.path
  159.     Input #1,Port$
  160.     
  161.     Close
  162.     On error goto 0            ' no special error trapping for now
  163.  
  164. ' -----------------------------------------------------------------------
  165.  
  166. ' If you have MS 5.36 or IBM BASCOM 1.0 compiler, put in a "GOTO 2001" here
  167.                     
  168. ' -----------------------------------------------------------------------
  169.                     
  170.     z=Command$            ' doesn't work for MS 5.36 and IBM BASCOM 1.0
  171.     call Mhucase(z)                 ' convert to uppercase
  172.     if instr(z,"/C")=0 then 5000    ' not reconfiguring
  173.     goto 2001               ' reconfigure
  174.     
  175. ' -----------------------------------------------------------------------
  176.                     
  177. 1500    ' If we get here, we had an invalid config file
  178.  
  179.     Er%=0                ' clear the BASIC error
  180.     Resume 2000            ' do the config file setup
  181.  
  182. ' -----------------------------------------------------------------------
  183.                     
  184. 2000    ' No configuration file was found, so we'll set it up.
  185.  
  186.     ' The Mhscr routine is the "instant screen display" routine
  187.     ' found in Mach 2.
  188.  
  189.     On error goto 0            ' no special error trapping for now
  190.     Close
  191.     gosub 51000            ' set up values for default monitor
  192.     gosub 54000            ' display copyright notice
  193.     
  194.     Lin=10
  195.     z="Invalid or missing DIALER.CNF (configuration file)."
  196.     Call Mhscr(Page,z,Lin,One,Lowlight.color)
  197.     Lin=Lin+2
  198.     z="If you wish to continue, answer 'Y' to the following"
  199.     Call Mhscr(Page,z,Lin,One,Lowlight.color)
  200.     Lin=Lin+1
  201.     z="question. Any other key will end this program."
  202.     call Mhscr(Page,z,Lin,One,Lowlight.color)
  203.     Lin=Lin+2
  204.     z="Do you want to set up a configuration file?"
  205.     call Mhscr(Page,z,Lin,One,Lowlight.color)
  206.     
  207.     ' Now we'll clear the keyboard and get a key press
  208.     
  209.     Lin=15
  210.     Column=45
  211.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,Page,Kshift,Kscan,Kascii)
  212.  
  213.     if Kscan=21 then z="Yes" else z="No"    ' 21 is scan code for 'Y' and 'y'
  214.     
  215.     call Mhscr(Page,z,Lin,Column,Highlight.color)' display the answer
  216.     
  217.     if Kscan<>21 then 63000            ' didn't press 'Y'
  218.  
  219. 2001    ' come here if reconfiguring
  220.  
  221.     Restore 2000            ' set up data entry screen
  222.     
  223.     For Lin=17 to 22
  224.       Read z
  225.       call Mhscr(Page,z,Lin,One,Lowlight.color)
  226.     next  
  227.     
  228.     data "Snow Checking  . . . . . "
  229.     data "Monitor to use . . . . . :
  230.     data "Phone directory file name:
  231.     data "Press your hot key . . . :
  232.     data "Drive/path for swapping  :
  233.     data "Communications port  . . :
  234.     
  235.     For Which.config=1 to 6
  236.       gosub 2900            ' display current data
  237.     next  
  238.  
  239.     Which.config=1            ' start configuring with Snow.checking
  240.     
  241. ' -----------------------------------------------------------------------
  242.  
  243. '    Configuration input area
  244.                     
  245.     
  246. 2010    ' display messages
  247.     
  248.     on Which.config goto 2100,2200,2300,2400,2500,2600
  249.     
  250. 2100     ' Snow checking
  251.     
  252.     Restore 2100
  253.     goto 2800
  254.     
  255.     data "Use space bar to toggle snow checking on and off.
  256.     data "Note that snow checking is not used on a monochrome monitor.
  257.     
  258. 2200     ' Monitor to use
  259.  
  260.     Restore 2200
  261.     goto 2800
  262.     
  263.     data "Use space bar to toggle which monitor to use when this program
  264.     data "becomes memory resident. Default means current monitor is used. 
  265.     
  266. 2300    ' Telephone directory name
  267.  
  268.     Restore 2300
  269.     goto 2800
  270.     
  271.     data "Enter the default file name for your telephone directory.
  272.     data "You may include a disk drive and path."
  273.     
  274. 2400    ' Hot key to activate program
  275.  
  276.     Restore 2400
  277.     goto 2800
  278.         
  279.     data "Press Ctrl and/or Alt and/or Shift and another key that you wish to use to
  280.     data "popup this program up after it has become memory resident.
  281.  
  282. 2500    ' Drive/path for swapping
  283.  
  284.     restore 2500
  285.     goto 2800
  286.     
  287.     data "Please enter the drive and path to use for disk swapping.
  288.     data "This option requires DOS 3 or later. See DIALER.DOC if questions.
  289.  
  290. 2600    ' Com port
  291.  
  292.     restore 2600
  293.     goto 2800
  294.     
  295.     data "Use the space bar to toggle between COM1 and COM2.
  296.     data ""
  297.  
  298. 2800     ' get input here at column 28
  299.  
  300.     for n=1 to 2        ' read messages
  301.       read z
  302.       lset Zmessage(n)=z
  303.     next  
  304.  
  305.     lset Zmessage(3)="<Enter>=Accept    Esc=End program     F1=Save data/go resident
  306.     gosub 54100        ' display all messages
  307.  
  308. 2805    ' come here to redo input
  309.  
  310.     gosub 2900        ' display current item
  311.     
  312.     Colr=Highlight.color
  313.     if Which.config=3 or Which.config=5 then 2810' for edited input
  314.     
  315.     ' Now we'll clear the keyboard and get a key press
  316.     
  317.     Column=28
  318.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,Page,Kshift,Kscan,Kascii)
  319.     goto 2820
  320.  
  321. 2810    ' edited input    
  322.  
  323.     Fill.character=32
  324.     Response.actual$=space$(50)    ' max allowable characters
  325.     Call MhInput (Stack$,Response.default$,Highlight.color,Curs.normal,Curs.insert,Fill.character,Lin,Column,Page,False,False,False,Kshift,Kscan,Kascii,Response.actual$,Ecode)
  326.     n=instr(Response.actual$,chr$(0))
  327.     if n then Response.actual$=left$(Response.actual$,n-1)
  328.  
  329. 2820    ' check results
  330.  
  331.     on Which.config gosub 3100,3200,3300,3400,3500,3600
  332.     
  333.     gosub 2900            ' display data
  334.         
  335.     if Kscan=59 and Kshift=0 then 4000    ' F1 to save config file
  336.     if Kscan=1 and Kshift=0 then 63000    ' end program    
  337.     
  338.     if Kshift=0 and (Kscan=28 or Kscan=80) then 2850 ' return/down arrow
  339.     if Kshift=0 and Kscan=72 then 2860    ' up arrow
  340.     
  341.     goto 2805                ' redo input
  342.  
  343. 2850    ' next item
  344.  
  345.     Which.config=Which.config+1
  346.     if Which.config>6 then Which.config=1
  347.     goto 2010
  348.     
  349. 2860    ' previous item    
  350.  
  351.     Which.config=Which.config-1
  352.     if Which.config<1 then Which.config=6
  353.     goto 2010
  354.     
  355. ' -----------------------------------------------------------------------
  356.  
  357. 2900    ' Displays the current status of one configuration item
  358.  
  359.     Lin=Which.config+16
  360.     on Which.config goto 2910,2920,2930,2940,2950,2960
  361.     
  362. 2910    ' snow checking
  363.  
  364.     if Snow.checking then z="On " else z="Off
  365.     goto 2980
  366.     
  367. 2920    ' monitor
  368.  
  369.     z=mid$("Mono   Color  Default",(Monitor.to.use-1)*7+1,7)
  370.     goto 2980
  371.     
  372. 2930    ' phone directory filename
  373.  
  374.     z=Zdata.file
  375.     goto 2980
  376.  
  377. 2940    '
  378.  
  379.     z="Scan code:"+Str$(Scan.code)+"  Shift status: "
  380.     if (Shift.status and 1)=1 then z=z+"Shift "
  381.     if (Shift.status and 4)=4 then z=z+"Ctrl "
  382.     if (Shift.status and 8)=8 then z=z+"Alt"
  383.     if Shift.status=0 or Scan.code=0 then z="Not yet selected
  384.     goto 2980
  385.  
  386. 2950    ' drive/path for swapping
  387.  
  388.     z=Zswap.path
  389.     goto 2980
  390.  
  391. 2960    '
  392.  
  393.     z=Port$
  394.     goto 2980
  395.     
  396. 2980    ' display the current data
  397.  
  398.     Response.default$=z    ' for edited input if necessary
  399.     z=z+space$(50-len(z))    ' to clear the rest of the line
  400.     Column=28
  401.     call Mhscr(Page,z,Lin,Column,Highlight.Color)
  402.     
  403. 2990    Return        
  404.                     
  405. ' -----------------------------------------------------------------------
  406.  
  407. 3100     ' snow checking
  408.  
  409.     if Kscan=57 then Snow.checking=Snow.checking xor True    ' toggle it
  410.     Return
  411.     
  412. ' -----------------------------------------------------------------------
  413.  
  414. 3200    ' monitor
  415.  
  416.     if Kscan=57 then Monitor.to.use=Monitor.to.use+1:If Monitor.to.use>3 then Monitor.to.use=1
  417.     Return
  418.     
  419. ' -----------------------------------------------------------------------
  420.  
  421. 3300     ' Data file
  422.  
  423.     Zdata.file=Response.actual$
  424.     Return
  425.     
  426. ' -----------------------------------------------------------------------
  427.  
  428. 3400    ' Hot key
  429.  
  430.     if Kshift=0 then return ' must be a shifted key
  431.  
  432.     Scan.code=Kscan
  433.     Shift.status=Kshift
  434.     Return
  435.  
  436. ' -----------------------------------------------------------------------
  437.  
  438. 3500    ' swapping
  439.     
  440.     Zswap.path=Response.actual$
  441.     Return
  442.     
  443. ' -----------------------------------------------------------------------
  444.  
  445. 3600    ' Com port
  446.  
  447.     if Kscan=57 then If Port$="COM1" then Port$="COM2" else Port$="COM1"
  448.     return    
  449.  
  450. ' -----------------------------------------------------------------------
  451.  
  452. 4000    ' save config file
  453.  
  454.     Open "o",1,"Dialer.cnf"        ' open the config file
  455.     Write #1,Snow.checking,Monitor.to.use,Zdata.file,Scan.code,Shift.status,Zswap.path,Port$
  456.     Close
  457.     
  458. ' -----------------------------------------------------------------------
  459.  
  460. 5000    ' set up monitor, colors and read data file
  461.  
  462.     gosub 54000            ' print copyright notice
  463.     
  464.  
  465.     Spec$=Zdata.file+chr$(0)
  466.     gosub 54200            ' check file presence
  467.     if Ecode then 5100        ' not found    
  468.  
  469.     if Scan.code=0 or Shift.status=0 then 5200      ' no hot key
  470.     
  471.     if Zswap.path="" then 10000    ' no need to check path
  472.  
  473.     Call Mhdver(Major,Minor)    ' get DOS version
  474.     
  475.     if Major<3 then z="Disk swapping requires DOS 3.0 or later!":goto 62000
  476.  
  477.     if right$(Zswap.path,1)="\" then Zswap.path=left$(Zswap.path,Len(Zswap.path)-1)
  478.     
  479.     Operation=7
  480.     kshift=varptr(Zswap.path)
  481.     gosub 50000            ' call stayres
  482.     if ecode=False then 10000    ' no error
  483.     
  484.     z="Unable to use "+zswap.path+" for swapping.
  485.     goto 62000        
  486.  
  487. 5100    ' no data file
  488.  
  489.     print
  490.     print "Unable to locate "+Zdata.file
  491.     goto 5900
  492.  
  493. 5200    ' invalid hot key
  494.  
  495.     print
  496.     print "Invalid or no hot key selected. 
  497.  
  498. 5900    print "Press a key for the configuration menu ";
  499.     z=input$(1)
  500.     goto 2001
  501.  
  502. ' -----------------------------------------------------------------------
  503.  
  504. 10000    ' become memory resident
  505.  
  506.     Operation=5            ' check if EMS memory is available
  507.     gosub 50000            ' call Stay-Res
  508.     if Ecode=False and Zswap.path="" then print "EMS memory will be used for program storage.
  509.  
  510.     print
  511.     print "Loading ";Zdata.file;
  512.     
  513.     gosub 55000            ' load the file
  514.     
  515.     gosub 56000            ' get date and time of file
  516.     ztime=Tim$
  517.     zdate=Dat$            ' save for checking later
  518.  
  519. 10100    ' final setup    
  520.  
  521.     print
  522.     if Total.records=0 then z="No entries in telephone directory.":goto 62000
  523.  
  524.     if Snow.checking=False then Ecode=100    ' tell Stay-Res
  525.     Start.data=1                ' first phone number to display
  526.     Current.line=2                ' line to highlight
  527.     locate ,,1                ' visible cursor in DOS please
  528.     Zmessage(1)=""                ' no longer needed
  529.     Zmessage(2)=Space$(76)            ' new message string
  530.     Zmessage(3)=Zmessage(2)            ' ditto
  531.  
  532. ' -----------------------------------------------------------------------
  533.  
  534. 11000    ' This is where we become memory resident and go back to sleep again
  535.  
  536.     Operation=0
  537.     Kshift=Shift.status
  538.     Kscan=Scan.code
  539.     gosub 50000            ' call Stay-Res
  540.  
  541.     on error goto 40000        ' trap BASIC errors at 40000
  542.  
  543.     on Monitor.to.use gosub 53000,52000,51000       ' set up values
  544.  
  545.     call Mhvideo(Monitor)
  546.     If Snow.checking=False then n=&hffff:call Mhvideo(n)    ' tell Mach 2 no snow checking
  547.  
  548.  
  549.     if Ecode>1 then z="Error"+str$(Ecode)+" when attempting to become memory resident.":goto 62000
  550.     if Ecode<>0 or Kscan>7 then gosub 54300:goto 11000' DOS not available or bad video mode - go back to sleep
  551.  
  552.     Def seg=0
  553.     Current.Monitor=peek(&h410)
  554.     Def seg
  555.     
  556.     if (Current.Monitor AND &h30)=&h30 then Current.monitor=&hb000 else Current.monitor=&hb800
  557.  
  558.     if Current.monitor=Monitor then 11100    ' if the same, the screen has been saved by Stay-Res
  559.  
  560.     Memory$=space$(4000)            ' to hold the current video memory
  561.                         ' on the other monitor
  562.     A!=varptr(memory$)
  563.     A=PEEK(A!+2)                            ' due to bug in QB 2, all this rigamorol is necessary
  564.     A!=(PEEK(A!+3))                          ' address of string
  565.     A!=A!*256+a
  566.     n=val("&h"+hex$(A!))                    ' convert to integer
  567.     a=4000
  568.     Column=&hffff
  569.     Call Mhmove (Monitor,Page,a,column,n)    ' save the screen
  570.  
  571.     goto 12000                ' we must assume text mode
  572.         
  573. 11100    ' Current monitor and our monitor are the same
  574.  
  575.     if Kscan=2 or Kscan=3 or Kscan=7 then 12000    ' no need change mode
  576.     If Monitor=&hb000 then Kscan=7 else Kscan=3    ' mono/color modes
  577.     Operation=2                    ' set video mode
  578.     gosub 50000                    ' let Stay-Res do it.
  579.  
  580. 12000    '  draw our screen
  581.  
  582.     z=space$(80)                            ' can't do CLS, since we
  583.     for Lin=1 to 25                         ' might be on alternate monitor
  584.       call Mhscr(Page,z,Lin,one,Lowlight.color)
  585.     next
  586.     Top.row=1                               ' draw a box
  587.     Left.column=1
  588.     Bottom.row=25
  589.     Right.column=80
  590.     box=2
  591.     Colr=Highlight.color
  592.     Operation=4
  593.     gosub 50100                ' call the window manager
  594.     
  595.     z=chr$(181)+" MicroHelp Dialer Program  (404) 973-9272 "+chr$(198)
  596.     Column=20
  597.     call Mhscr(Page,z,One,Column,Highlight.color)    ' display our banner
  598.     
  599.     z=chr$(199)+string$(78,196)+chr$(182)    ' to draw a line near bottom
  600.     Column=22
  601.     call Mhscr(Page,z,Column,One,Highlight.color)
  602.  
  603.     gosub 56000                ' get date/time of phone directory
  604.     if Ecode then Ecode=0:goto 12100    ' error on open
  605.     if ztime=Tim$ and zdate=dat$ then 12100    ' file has not changed
  606.  
  607. 12050    Restore 12050
  608.     gosub 54150                ' display two messages    
  609.  
  610.     data Reloading telephone directory due to change in file . . .
  611.     data ""
  612.     
  613.     ztime=Tim$                ' reset for next time
  614.     Zdate=dat$
  615.     gosub 55000                ' reload the file
  616.  
  617. 12100    ' display some data
  618.  
  619.     z=space$(76)
  620.     
  621.     Column=3
  622.     For Lin=2 to 21
  623.       Lset z=Zphone.entry(Lin+Start.data-2)        ' which entry
  624.       call Mhscr(Page,z,Lin,Column,Lowlight.color)    ' display it
  625.       if z<>space$(76) then Last.line.with.data=Lin    ' for movement keys
  626.     Next  
  627.  
  628. 12200    ' highlight current record by changing color attributes
  629.  
  630.     Column=3
  631.     n=76
  632.     Call Mhscatt(Page,Current.Line,Column,Inverse.color,n)
  633.     
  634. 12300    ' display message and get input
  635.  
  636.     restore 12300
  637.     data "Press <Enter> to dial    PgUp  PgDn      to change selection" 
  638.     data Esc=Go back to sleep   F2=Disappear from memory   F3=Search Directory
  639.     gosub 54150                ' display two messages    
  640.  
  641. 12310    ' clear keyboard and get key with invisible cursor
  642.  
  643.     Lin=26
  644.     Call Mhkclr (Stack$,Invisible.cursor,Lin,One,Page,Kshift,Kscan,Kascii)
  645.  
  646.     if Kscan=28 then 12400        ' dial current number
  647.     if Kscan=72 then 12500        ' up arrow
  648.     if Kscan=80 then 12600        ' down arrow
  649.     if Kscan=73 then 12700        ' pgup
  650.     if Kscan=81 then 12800        ' pgdn
  651.     if Kscan=60 then 13000        ' F2 disappear from memory
  652.     if Kscan=61 then 13100        ' F3 search
  653.  
  654.     if Kscan=1  then gosub 12900:goto 11000        ' Esc back to sleep
  655.     
  656.     goto 12310            ' invalid key    
  657.     
  658. 12400    ' dial it    
  659.     
  660.     z=space$(19)            ' string to read number into
  661.     n=19
  662.     Column=58
  663.     Call Mhrscr(Page,z,Current.Line,Column,n)    ' read number from screen
  664.     if z=space$(19) then gosub 54300:goto 12310 ' no number there!
  665.     
  666.     on error goto 12450        ' modem errors
  667.     Close
  668.         Open "r",1,Port$+":300,E,7,1,CS,DS,CD"
  669.         print #1, "ATM1 S11=40DT"+z
  670.  
  671.     on error goto 40000        ' BASIC errors
  672.  
  673. 12410    ' get instructions
  674.  
  675.     restore 12410
  676.     data "Press <Enter> when party answers or to return to menu 
  677.     data  R=Redial
  678.     gosub 54150                ' display two messages    
  679.  
  680. 12420    ' get a key
  681.  
  682.     Lin=23
  683.     Column=58
  684.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,Page,Kshift,Kscan,Kascii)
  685.     
  686.     if Kscan=28 then gosub 12440:goto 12300    ' escape
  687.     if Kscan=19 then gosub 12440:goto 12400    ' hangup and redial
  688.     goto 12420                ' get another key    
  689.  
  690. 12440    ' hangup the phone
  691.  
  692.     on error goto 12450
  693.         print #1, "ATM1 H0 Z"                           'hang up
  694.     close
  695.     on error goto 40000
  696.     Return    
  697.     
  698. 12450    ' phone/modem error
  699.  
  700.     z=space$(76)
  701.     lset z="Modem error"+str$(err)
  702.     er%=0
  703.     resume 12460
  704.     
  705. 12460    ' continue with error
  706.     
  707.     on error goto 40000
  708.     Lin=23
  709.     Column=3
  710.     call Mhscr(Page,z,Lin,Column,Highlight.color)
  711.     lset z="Press a key.
  712.     Lin=24
  713.     call Mhscr(Page,z,Lin,Column,Highlight.color)
  714.     Column=16
  715.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,Page,Kshift,Kscan,Kascii)
  716.     goto 12300
  717.  
  718. 12500    ' up arrow pressed
  719.  
  720.     Column=3        ' un-highlight current selection
  721.     n=76
  722.     Call Mhscatt(Page,Current.Line,Column,Lowlight.color,n)
  723.     Current.line=Current.line-1    
  724.     if Current.line=1 then Current.line=Last.line.with.data
  725.     goto 12200        ' highlight current line    
  726.  
  727. 12600    ' down arrow pressed
  728.  
  729.     Column=3        ' un-highlight current selection
  730.     n=76
  731.     Call Mhscatt(Page,Current.Line,Column,Lowlight.color,n)
  732.     Current.line=Current.line+1    
  733.     if Current.line>Last.line.with.data then Current.line=2
  734.     goto 12200        ' highlight current line    
  735.  
  736. 12700    ' Pgup pressed
  737.  
  738.     if Total.records<20 then 12300    ' no more records
  739.     Current.line=2            ' current line is top line
  740.     
  741.     if Start.data=1 then Start.data=Total.records-19:goto 12100
  742.     Start.data=Start.data-20
  743.     if Start.data<1 then Start.data=1
  744.     goto 12100    
  745.     
  746. 12800    ' Pgdn pressed
  747.  
  748.     if Total.records<20 then 12300    ' no more records
  749.     Current.line=2            ' current line is top line
  750.     Start.data=Start.data+20
  751.     if Start.data>Total.records then Start.data=1
  752.     goto 12100    
  753.  
  754. 12900    ' Restore alternate monitor if necessary
  755.  
  756.     if Current.monitor=Monitor then return    ' no need restore screen    
  757.  
  758.     A!=varptr(memory$)
  759.     
  760.     A=PEEK(A!+2)                            ' due to bug in QB 2, all this rigamorol is necessary
  761.     A!=(PEEK(A!+3))                          ' address of string
  762.     A!=A!*256+a
  763.     n=val("&h"+hex$(A!))                    ' convert to integer
  764.     ffff=&hffff
  765.     Bytes=4000
  766.     Call Mhmove (ffff,n,bytes,Monitor,Page)    ' restore the screen
  767.     return    
  768.  
  769. 13000    ' disappear from memory
  770.  
  771.     restore 13000
  772.     gosub 54150                    ' display two message
  773.  
  774.     data Do not disappear from memory if any other program is running or you loaded
  775.     data any other resident programs after this. Do you still want to disappear?
  776.  
  777.     Column=75
  778.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,Page,Kshift,Kscan,Kascii)
  779.  
  780.     if kscan<>21 then 12300            ' if didn't press 'Y'
  781.     gosub 12900                ' restore screen
  782.     Operation=9
  783.     gosub 50000                ' call stayres
  784.     
  785.     ' if we get back from the call to Stay-Res, it means we were unable
  786.     ' go disappear from memory
  787.  
  788. 13050   restore 13050
  789.     
  790.     data Unable to disappear from memory at this time.
  791.     data Press any key to go back to sleep.
  792.     gosub 54150                    ' display two message
  793.  
  794.     Column=39
  795.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,Page,Kshift,Kscan,Kascii)
  796.     goto 12300
  797.  
  798. 13100    ' search phone directory
  799.  
  800.     data "Please enter the characters to search for ('Esc' cancels search):
  801.     data ""
  802.     restore 13100
  803.     gosub 54150                    ' display two message
  804.             
  805.     Response.default$=Search.string$            ' repeat if previously searched
  806.     lset zmessage(3)=Response.default$
  807.     call Mhscr(Page,zmessage(3),Lin,Column,Highlight.color)  ' display default response
  808.  
  809.     Fill.character=32
  810.     Response.actual$=space$(50)    ' max allowable characters
  811.     Call MhInput (Stack$,Response.default$,Highlight.color,Curs.normal,Curs.insert,Fill.character,Lin,Column,Page,False,False,False,Kshift,Kscan,Kascii,Response.actual$,Ecode)
  812.     if Kscan=1 then 12300        ' escape pressed
  813.     n=instr(Response.actual$,chr$(0))
  814.     if n then Response.actual$=left$(Response.actual$,n-1)
  815.  
  816.     Search.string$=Response.actual$        ' save for repeated searches
  817.     z=Search.string$            ' so we can convert to
  818.     call Mhucase(z)                ' upper case for comparison (i.e. ignore case)
  819.     
  820.     if Search.start=0 or Search.start>Total.records then Search.start=1
  821.     ' Search.start is the record at which the next search will begin
  822.     
  823.     Temp=Search.start            ' start looking here
  824.     
  825. 13200    '
  826.  
  827.     z2=Zphone.entry(Temp)                   ' so we can convert to
  828.     call Mhucase(z2)            ' upper case for search
  829.     if instr(z2,z) then 13500        ' Found one!
  830.     if Total.records=1 then 13300           ' just in case
  831.  
  832.     Temp=temp+1                ' didn't find one
  833.     if Temp=Search.start then 13300         ' end of file reached without finding a match
  834.     if Temp<=Total.records then 13200       ' keep looking
  835.     if Search.start=1 then 13300            ' no need to wrap
  836.     Temp=1                                  ' wrap around
  837.     goto 13200
  838.     
  839. 13300    '  end of file - no match    
  840.  
  841.     restore 13300
  842.     gosub 54150                    ' display two message
  843.     
  844.     data No match found.
  845.     data Press a key to continue
  846.  
  847.     Column=27
  848.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,False,Kshift,Kscan,Kascii)
  849.     goto 12300
  850.         
  851. 13500   '  found a string
  852.  
  853.     Start.data=(Temp+9)/20                  ' appropriate page
  854.     Start.data=(Start.data-1)*20+1        ' start display with this item
  855.     Current.line=Temp-Start.data+2          ' flag for highlight routine
  856.     Search.start=Temp+1            ' mark the next one
  857.     goto 12100                ' display the data
  858.         
  859. ' -----------------------------------------------------------------------
  860.  
  861. 40000    ' trap BASIC errors here
  862.  
  863.     z="BASIC error"+str$(err)+" encountered at line"+str$(erl)+". Press a key."
  864.     er%=0
  865.     resume 40010
  866.     
  867. 40010
  868.     Lin=24                ' display BASIC error message
  869.     Column=3
  870.     call Mhscr(Page,z,Lin,Column,Lowlight.color)
  871.     Column=75
  872.     Call Mhkclr (Stack$,Curs.normal,Lin,Column,False,Kshift,Kscan,Kascii)
  873.     gosub 12900            ' back to sleep    
  874.     goto 11000
  875.     
  876. ' -----------------------------------------------------------------------
  877.  
  878. 50000   Call Stayres(Operation,Kscan,Kshift,Ecode)
  879.     Return    
  880.  
  881. ' -----------------------------------------------------------------------
  882.  
  883. 50100     ' Calls the Mach 2 window manager - we'll use it to draw boxes
  884.  
  885.     Call Mhwind (Stack$,Colr,Dtaseg,Operation,Page,Top.row,Left.column,Bottom.row,Right.column,Buffer.number,Box,Ecode)
  886.     Return
  887.  
  888. ' -----------------------------------------------------------------------
  889.  
  890. 51000    ' sets up values for default monitor
  891.     
  892.     Def seg=0
  893.     Monitor=peek(&h410)            ' equipment byte
  894.     Def seg
  895.     
  896.     if (Monitor AND &h30)=&h30 then 53000    ' monochrome
  897.     
  898. 52000   ' sets up values for color monitor
  899.  
  900.     Monitor=&hb800                ' color monitor memory
  901.     Lowlight.color=27
  902.     Highlight.color=30
  903.     Inverse.color=113
  904.     Curs.normal=1543            ' same as locate ,,,6,7
  905.     Curs.insert=1031            ' same as locate ,,,4,7
  906.     locate ,,0,6,7
  907.     Return
  908.     
  909. 53000   ' sets up values for monochrome monitor
  910.     
  911.     Monitor=&hb000                ' mono monitor memory
  912.     Lowlight.color=7
  913.     Highlight.color=15
  914.     Inverse.color=112
  915.     Curs.normal=3085            ' same as locate ,,,12,13
  916.     Curs.insert=1293                        ' same as locate ,,,5,13
  917.     locate ,,0,12,13
  918.     Return
  919.  
  920. 54000    ' display the copyright screen
  921.  
  922.     restore 54000
  923.     Cls
  924.     
  925.     Top.row=1        ' we'll draw a box
  926.     Left.column=1
  927.     Bottom.row=9
  928.     Right.column=80
  929.     Box=2            ' double line
  930.     Operation=4             ' tells window manager to draw a box
  931.     Colr=Highlight.color
  932.     gosub 50100        ' call the window manager
  933.     
  934.     Column=7
  935.     for Lin=2 to 8
  936.       read z
  937.       call Mhscr(Page,z,Lin,Column,Lowlight.color)
  938.     next
  939.     locate 10,1
  940.     return  
  941.  
  942.     data "DIALER.EXE Copyright (C) 1987 MicroHelp, Inc.
  943.     data ""
  944.     data "This program may be freely copied and distributed provided that 
  945.     data "all copyright notices are left intact and that you distribute all
  946.     data "of the following files in an unmodified state:
  947.     data ""
  948.     data "     DIALER.BAS, DIALER.EXE and DIALER.DOC
  949.     
  950. 54100    '  display instructions on bottom 3 screen lines
  951.  
  952.     For Lin=23 to 25
  953.       n=Lin-22
  954.       call Mhscr(Page,Zmessage(n),Lin,One,Highlight.color)
  955.     next
  956.     Return  
  957.  
  958. 54150    ' display instructions on bottom 2 screen lines
  959.     ' RESTORE linenumber has been done before calling this routine
  960.     
  961.     read z
  962.     lset Zmessage(2)=z
  963.     Lin=23
  964.     Column=3
  965.     call Mhscr(Page,Zmessage(2),Lin,Column,Highlight.color)
  966.     read z
  967.     lset Zmessage(3)=z
  968.     Lin=24
  969.     call Mhscr(Page,Zmessage(3),Lin,Column,Highlight.color)
  970.     Return
  971.     
  972. 54200    '  check for file presence. come in with Spec$ set to ASCIIZ string
  973.  
  974.     Fil.name$=space$(13)        ' the assembler routine returns the file name
  975.     Call Mhfind (Stack$,Spec$,n,Fil.name$,One,Ecode)
  976.     Return    
  977.  
  978. 54300    ' make some noise - this works with compiled or interpreted BASIC!
  979.  
  980.     OUT &H43,182'            set up for sound
  981.     OUT &H42,&H33'            low part of sound
  982.     OUT &H42,5'            high part
  983.     N=INP(&H61):N1=N'            save for later
  984.     N=N OR 3
  985.     OUT &H61,N'            turn on speaker
  986.     FOR A!=1 TO 500:NEXT'        delay
  987.     OUT &H42,&H33'            low part
  988.     OUT &H42,6'            high part
  989.     FOR A!=1 TO 500:NEXT'        delay
  990.     OUT &H61,N1'            turn off speaker
  991.     RETURN
  992.  
  993. 55000    ' load the telephone directory
  994.  
  995.     Close
  996.     Open "i",1,Zdata.file
  997.     Total.records=0
  998.     
  999. 55010    ' read next record    
  1000.  
  1001.     if eof(1) then 55090            ' no more data    
  1002.     Total.records=Total.records+1
  1003.     Line input #1,z
  1004.     Zphone.entry(Total.records)=space$(76)
  1005.     lset Zphone.entry(Total.records)=z
  1006.     if Total.records<200 then 55010 
  1007.  
  1008. 55090    close
  1009.     return    
  1010.  
  1011. 56000    '  get date and time of phone directory file
  1012.  
  1013.     Fil.name$=Zdata.file+chr$(0)    ' file name must be ASCIIZ string
  1014.     Call Mhfile (Stack$,False,Fil.name$,False,Attributes%,Handle%,Ecode%)    ' open the file
  1015.     if Ecode then 56010        ' get out if error
  1016.     Tim$="00:00:00"
  1017.     Dat$="00/00/00"
  1018.     Call Mhfdate (Stack$,Handle%,One,Tim$,Dat$,Ecode%)    ' get date/time
  1019.     Fil.name$=""            ' close the file    
  1020.     Call Mhfile (Stack$,False,Fil.name$,False,Attributes%,Handle%,Ecode%)    ' open the file
  1021.  
  1022. 56010    return    
  1023.  
  1024. 62000    ' program end with error
  1025.     
  1026.     locate 23,1
  1027.     print z                ' error message
  1028.     print    
  1029.     print "Program will not be memory resident.
  1030.     print
  1031.  
  1032. 63000   ' program end
  1033.     color 7,0,0
  1034.     locate 25,1
  1035.     End
  1036.